perm filename MISCUR.SAI[SYS,HE]7 blob
sn#037172 filedate 1973-04-23 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 BEGIN "MISC"
00006 00003 ⊃ DISPLAY LINES BEING FIT
00009 00004 ⊃ FIRST ATTEMPT TO EXTEND DANGLING ENDPOINTS
00014 00005 ⊃ 3. IF INTERSECTED LINE LESS THAN COORDMAX
00017 00006 ⊃ MERGE ALL ENDPOINTS WITHIN COORDMAX OF EACH OTHER
00020 00007 ⊃ REMOVE ALL LINES NOT PART OF CLOSED OUTLINE
00023 00008 ⊃ generate table of verticies and line links
00025 00009 ⊃ FIND REGION BY STARTING WITH LOWEST ENDPOINT
00027 00010 ⊃ PROCESS FITTED OUTLINE
00029 00011 ⊃ FIT COMMAND ENTRY
00031 00012 ⊃ DUMP CURVE FITTER DATA STRUCTURE ON DISK FILES
00036 00013 ⊃ MAIN PROGRAM
00038 00014 ⊃ READ IN OBJECTS FROM DISK FILE AND PROCESS
00041 ENDMK
⊗;
BEGIN "MISC"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE "SQRT[SYS,HE]" LOAD_MODULE;
REQUIRE 500 STRING_SPACE;
REQUIRE 200 NEW_ITEMS;
EXTERNAL INTEGER PROCEDURE CUR1(REAL ARRAY D,LINES;INTEGER ARRAY JOIN;
REFERENCE INTEGER SCNT,SMAX);
EXTERNAL PROCEDURE CUROFF;
EXTERNAL REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE CURVON;
EXTERNAL PROCEDURE ARROW_DPY(REAL X,Y);
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE PROC);
EXTERNAL PROCEDURE FRDCHG(REAL X,Y;PROCEDURE PROC);
EXTERNAL PROCEDURE FNDINT(REFERENCE REAL LINES; REFERENCE INTEGER I,JOIN,A;
INTEGER C);
EXTERNAL BOOLEAN PROCEDURE FND;
EXTERNAL PROCEDURE DUP(REFERENCE REAL L; REFERENCE INTEGER C);
EXTERNAL PROCEDURE MERGE(REFERENCE INTEGER I,E,INDEX;REAL X1,Y1;
REFERENCE REAL X2,Y2,LINES;INTEGER C);
EXTERNAL INTEGER PROCEDURE GET(REAL X,Y);
EXTERNAL PROCEDURE GETINT(REFERENCE REAL V; REFERENCE INTEGER MX);
EXTERNAL PROCEDURE REGINT(INTEGER C,B;REAL X,Y;REFERENCE INTEGER I,J,COUNT;
REFERENCE REAL LINES);
EXTERNAL BOOLEAN PROCEDURE REGGET;
INTERNAL REAL COORDIF, COORDMAX, PARA;
EXTERNAL REAL TOLER, TOLER2, MINLEN, CORDIF, CORMX;
INTEGER J,I,EOF,BRK, DISSIZ, TVCAM;
INTERNAL SHORT INTEGER FRAMEY;
STRING INP;
INTEGER ITEMVAR NEWBLOB;
EXTERNAL BOOLEAN DD_DISP, XDEB, DISCUR, XDMP;
EXTERNAL SHORT INTEGER FRAMEX;
SAFE INTEGER ARRAY DISPL[1:300];
DEFINE CRLF="'15&'12",SAFEX="SAFE", SMAX="200", ⊃="COMMENT",
∂="GLOBAL DATUM", !="GLOBAL",
DPYSETUP="IF DD_DISP THEN RELPOG(FRAMEX);
IF FRAMEX<0 THEN FRAMEX ← GETPOG;
DPYSET(DISPL);
DPYBRT(7)";
BOOLEAN STAT_CURV;
FORWARD SIMPLE REAL PROCEDURE ANG(REAL DX,DY);
⊃ DISPLAY LINES BEING FIT;
INTERNAL PROCEDURE DISP(SAFEX REAL ARRAY D);
BEGIN SHORT INTEGER X, Y, CNT, PNT, I, J;
SAFEX INTEGER ARRAY DISPL[1:DISSIZ];
IF FRAMEY<0 THEN FRAMEY ← GETPOG;
DPYSET(DISPL);
DPYBRT(1);
FADCHG(0,0,AIVECT);
J ← 1;
DO BEGIN
CNT ← D[J,1];
PNT ← D[J,2];
FOR I ← 1 STEP 1 UNTIL CNT DO
FRDCHG(D[J+I,1],D[J+I,2],RPOINT);
J ← PNT;
END UNTIL ¬J;
DPYOUT(FRAMEY);
END;
⊃ PRINT CURRENT SET OF LINES;
SIMPLE PROCEDURE DUMPLINE(STRING FOO; SAFEX REAL ARRAY LINES; BOOLEAN ARRAY JOIN;
SHORT INTEGER C);
BEGIN "D1" SHORT INTEGER I;
OUT(3,FOO&CRLF);
FOR I←1 STEP 1 UNTIL C DO
OUT(3,CVS(I)&CVF(LINES[I,1])&CVF(LINES[I,2])&
(IF JOIN[I,1] THEN "*" ELSE " ")&
CVF(LINES[I,3])&CVF(LINES[I,4])&
(IF JOIN[I,2] THEN "*" ELSE " ")&CRLF);
OUT(3,CRLF);
END "D1";
⊃ ROUTINE TO CLEAN UP LINES FOR FUTURE PROCESSING;
PROCEDURE FIXUP(SAFEX REAL ARRAY LINES; SAFEX SHORT INTEGER ARRAY JOIN;
REFERENCE SHORT INTEGER C; SHORT INTEGER TESTX);
BEGIN
SAFEX SHORT INTEGER ARRAY INDEX[1:C,1:2];
SHORT INTEGER DCNT, I, IND, J, K, A, B, F, G, E, IDELT, JDELT;
REAL TEST, DD, X, Y, X1, Y1, X2, Y2, X3, Y3, XX, YY, A1, B1, C1, A2,
B2, C2, GX, GY, E1, E2, TST, LDIST, EDIST;
LABEL L1, L2, L3, L5, L6, L7, L8, JMP1;
DEFINE HANG(I)="JOIN[I,1]", OUTER(I)="JOIN[I,2]";
IF TESTX THEN GO TO JMP1;
⊃ FIRST ATTEMPT TO EXTEND DANGLING ENDPOINTS
[¬JOIN] TO SOME CORNER;
⊃ 1. FIND A DANGLING ENDPOINT;
SETFORMAT(10,3);
IF XDMP THEN DUMPLINE("BEFORE FIXUP",LINES,JOIN,C);
FOR I← 1 STEP 1 UNTIL C DO
BEGIN "DANGLE" REAL FOO, FOOX;
IF ¬JOIN[I,1] THEN E←1 ELSE
L2: IF ¬JOIN[I,2] THEN E←3 ELSE GO TO L1;
X ← LINES[I,E];
Y ← LINES[I,E+1];
K ← IF E=1 THEN 3 ELSE 1;
X1 ← LINES[I,K];
Y1 ← LINES[I,K+1];
EDIST ← LDIST ← 1000.0;
FOOX ← SQRT((X-X1)↑2+(Y-Y1)↑2);
FOO ← (FOOX-COORDMAX) MAX (FOOX/2.0);
⊃ 2. NOW I IS A DANGLING LINE AND E POINTS TO THE END POINT.
X,Y ARE COORDINATES OF THE DANGLING END
X1,Y1 ARE COORDINATES OF THE OTHER END.
FOOX IS THE LENGTH OF THE LINE
INTERSECT THE LINE WITH ALL OTHER LINES. SAVE CLOSEST
LINE (<COORDIF*2) WITH INTERSECTION ON LINE OR WITHIN
COORDIF OF IT IF BOTH LINES DANGLING;
FOR J←1 STEP 1 UNTIL C DO IF I≠J THEN
BEGIN "MATCH" LABEL L4,L1;
XX ← LINES[J,1];
YY ← LINES[J,2];
X2 ← LINES[J,3];
Y2 ← LINES[J,4];
IF (XX=X1∧YY=Y1)∨(X2=X1∧Y2=Y1) THEN GO TO L4;
A1 ← YY-Y2;
B1 ← X2-XX;
C1 ← X2*A1+Y2*B1;
A2 ← Y1-Y;
B2 ← X-X1;
C2 ← X*A2+Y*B2;
DD ← A1*B2-A2*B1;
IF ABS(DD)<0.01 THEN GO TO L4;
X3 ← (C1*B2-C2*B1)/DD;
Y3 ← (A1*C2-A2*C1)/DD;
E1 ← SQRT((X3-X)↑2+(Y3-Y)↑2);
IF XDEB THEN
BEGIN "D1"
SHORT INTEGER I;
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL C DO
BEGIN
FRDCHG(LINES[I,1],LINES[I,2],RIVECT);
FRDCHG(LINES[I,3],LINES[I,4],RVECT);
END;
ARROW_DPY(X,Y);
ARROW_DPY(X3,Y3);
FADCHG(50.0,260.0,AIVECT);
DPYSST("LDIST="&CVF(E1));
END "D1";
IF E1>(FOOX/2.0 MAX 4.0) THEN GO TO L4;
E2 ← SQRT((X3-XX)↑2+(Y3-YY)↑2);
TST ← SQRT((X3-X2)↑2+(Y3-Y2)↑2);
IF E2<TST THEN B←1 ELSE BEGIN B←3; E2←TST; END;
IF XDEB THEN
BEGIN "D2"
DPYSST(" EDIST="&CVF(E2));
ARROW_DPY(LINES[J,B],LINES[J,B+1]);
END "D2";
DCNT ← JOIN[J,(B DIV 2)+1];
IF SQRT((X3-X1)↑2+(Y3-Y1)↑2)<FOO THEN GO TO L1;
IF (F←(¬((XX MIN X2)≤X3≤(XX MAX X2)∧
(YY MIN Y2)≤Y3≤(YY MAX Y2))))∧
((DCNT∧E2>COORDMAX)∨(E2>COORDIF))
THEN GO TO L1;
IF F THEN
BEGIN
IF E1*E2>LDIST*EDIST∨E1>LDIST*2.0 THEN
GO TO L1;
END ELSE IF E1>LDIST THEN GO TO L1;
LDIST ← E1;
EDIST ← IF F THEN -E2 ELSE E2;
IDELT ← J;
JDELT ← B;
GX ← X3;
GY ← Y3;
L1: IF XDEB THEN
BEGIN
DPYSST(" ACDIST="&CVF(LDIST));
DPYOUT(FRAMEX);
INCHWL;
END;
L4: END "MATCH";
IF LDIST≥1000.0 THEN
BEGIN
IF XDMP THEN OUT(3,"FAILED"&CVS(I)&CVS(E)&CRLF);
GO TO L3;
END;
⊃ 3. IF INTERSECTED LINE LESS THAN COORDMAX
FROM END POINT, MOVE DANGLING LINE TO CORNER.
OTHERWISE, USE INTERSECTION AND TEST FOR PARALLEL;
J ← (JDELT DIV 2)+1;
K ← (E DIV 2) +1;
IF ABS(EDIST)<COORDMAX∧JOIN[IDELT,J] THEN
BEGIN "MOVE"
LINES[I,E] ← LINES[IDELT,JDELT];
LINES[I,E+1] ← LINES[IDELT,JDELT+1];
JOIN[I,K] ← 1;
IF XDMP THEN OUT(3,CRLF&"MOVED"&CVS(I)&CVS(E)&" TO"&
CVS(IDELT)&CVS(JDELT)&CRLF);
END "MOVE" ELSE IF EDIST<0 THEN BEGIN "JOIN"
A ← IF E=1 THEN 3 ELSE 1;
B ← IF JDELT=1 THEN 3 ELSE 1;
IF ABS((LINES[I,A+1]-GY)*(GX-LINES[IDELT,A])-
(LINES[I,A]-GX)*(GY-LINES[IDELT,B+1]))>PARA
THEN BEGIN "NOP"
LINES[I,E] ← LINES[IDELT,JDELT] ← GX;
LINES[I,E+1] ← LINES[IDELT,JDELT+1] ← GY;
JOIN[I,K] ← JOIN[IDELT,J] ← 1;
IF XDMP THEN OUT(3,CRLF&"JOIN"&CVS(IDELT)&
CVS(JDELT)&" AND"&CVS(I)&
CVS(E)&CRLF);
END "NOP" ELSE BEGIN "PARA"
LINES[I,E] ← LINES[IDELT,B];
LINES[I,E+1] ← LINES[IDELT,B+1];
JOIN[I,K] ← JOIN[IDELT,(B DIV 2)+1];
IF I<C THEN
BEGIN "PACK"
ARRBLT(LINES[IDELT,1],LINES[C,1],4);
ARRBLT(JOIN[IDELT,1],JOIN[C,1],2);
END "PACK";
C ← C-1;
IF XDMP THEN OUT(3,CRLF&CVS(I)&" PARALLEL"&
CVS(IDELT)&CRLF);
END "PARA";
END "JOIN" ELSE BEGIN "BREAK"
IF (C←C+1)>SMAX THEN
USERERR(0,0,"TOO MANY LINES TO BREAK");
LINES[C,3] ← LINES[IDELT,3];
LINES[C,4] ← LINES[IDELT,4];
JOIN[C,2] ← JOIN[IDELT,2];
LINES[I,E] ← LINES[IDELT,3] ← LINES[C,1] ← GX;
LINES[I,E+1] ← LINES[IDELT,4] ← LINES[C,2] ← GY;
JOIN[I,K] ← JOIN[IDELT,2] ← JOIN[C,1] ← 1;
IF XDMP THEN OUT(3,CRLF&"BREAK"&CVS(IDELT)&CRLF);
END "BREAK";
IF XDMP THEN DUMPLINE("FIXED",LINES,JOIN,C);
L3: IF E=1 THEN GO TO L2;
L1: END "DANGLE";
⊃ MERGE ALL ENDPOINTS WITHIN COORDMAX OF EACH OTHER
AND DELETE EXTRA LINES;
FOR I←1 STEP 1 UNTIL C DO FOR J←1,3 DO
BEGIN "L1"
X1 ← X2 ← LINES[I,J];
Y1 ← Y2 ← LINES[I,J+1];
MERGE(I,E←0,INDEX[1,1],X1,Y1,X2,Y2,LINES[I,1],C);
IF E THEN
BEGIN "L3"
Y1 ← Y2/(E+1);
X1 ← X2/(E+1);
LINES[I,J] ← X1;
LINES[I,J+1] ← Y1;
FOR K←1 STEP 1 UNTIL E DO
BEGIN "L4"
A ← INDEX[K,1];
B ← INDEX[K,2];
LINES[A,B] ← X1;
LINES[A,B+1] ← Y1;
END "L4";
END "L3";
END "L1";
DUP(LINES[1,1],C);
⊃ FIND ALL LINES WHICH MAY BE PART OF A CLOSED OUTLINE;
JMP1: JOIN[1,1] ← 0;
ARRBLT(JOIN[1,2],JOIN[1,1],C*2-1);
IF XDMP THEN DUMPLINE("AFTER MERGE",LINES,JOIN,C);
L5: FNDINT(LINES[1,1],I,JOIN[1,1],A←FALSE,C);
FOR I←1 STEP 1 UNTIL C DO
IF FND∧XDMP THEN OUT(3,CVS(I)&" HANGING"&CRLF);
IF A THEN GO TO L5;
IF XDEB THEN
BEGIN
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL C DO IF ¬HANG(I) THEN
BEGIN
FRDCHG(LINES[I,1],LINES[I,2],RIVECT);
FRDCHG(LINES[I,3],LINES[I,4],RVECT);
END;
DPYBRT(1);
FOR I←1 STEP 1 UNTIL C DO IF HANG(I) THEN
BEGIN
FRDCHG(LINES[I,1],LINES[I,2],RIVECT);
FRDCHG(LINES[I,3],LINES[I,4],RVECT);
END;
DPYOUT(FRAMEX);
INCHWL;
END;
⊃ REMOVE ALL LINES NOT PART OF CLOSED OUTLINE;
IND ← 0;
FOR I←1 STEP 1 UNTIL C DO IF HANG(I) THEN IND←IND+1;
IF IND THEN
BEGIN "REMOVE" SAFEX REAL ARRAY ARY[1:IND,1:4];
K ← J ← 0;
FOR I ← 1 STEP 1 UNTIL C DO IF HANG(I) THEN
ARRBLT(ARY[K←K+1,1],LINES[I,1],4) ELSE
IF (J←J+1)<I THEN ARRBLT(LINES[J,1],LINES[I,1],4);
C ← J;
! MAKE DANGLE⊗NEWBLOB≡! NEW(ARY);
IF XDMP THEN
BEGIN "D2"
DUMPLINE("OUTLINE",LINES,JOIN,C);
OUT(3,CRLF&"EXTRA LINES"&CRLF);
FOR I←1 STEP 1 UNTIL IND DO
BEGIN
FOR J←1 STEP 1 UNTIL 4 DO
OUT(3,CVF(ARY[I,J]));
OUT(3,CRLF);
END;
OUT(3,CRLF);
END "D2";
END "REMOVE";
PUT NEWBLOB IN BLOBS;
IF ¬C THEN RETURN;
STAT_CURV ← TRUE;
⊃ loop to generate global data structure;
BEGIN "DATA"
SAFEX REAL ARRAY VERT[1:C*2,1:2], PS[1:2];
SAFEX SHORT INTEGER ARRAY COUNT[1:C];
LIST ITEMVAR FOO;
SHORT INTEGER ITEMVAR FOOX;
LIST VERTICIES, PNTS;
BOOLEAN OUTS;
SET REGIONS, PER;
SHORT INTEGER VIND, K;
SAFEX REAL ARRAY ITEMVAR RAI;
REAL ITEMVAR RI;
⊃ generate table of verticies and line links;
PNTS ← PHI;
VIND ← 0;
GETINT(VERT[1,1],VIND);
FOR I←1 STEP 1 UNTIL C DO
BEGIN "GEN1"
RI ← ! NEW(0.0);
! MAKE LINE⊗NEWBLOB≡RI;
FOR J←1,3 DO
BEGIN "GEN2"
K←GET(LINES[I,J],LINES[I,J+1]);
IF ¬K THEN
BEGIN "GEN3"
RAI ← ! NEW(PS);
K←VIND ← VIND+1;
∂(RAI)[1]←VERT[K,1]←LINES[I,J];
∂(RAI)[2]←VERT[VIND,2]←LINES[I,J+1];
! MAKE POINT⊗NEWBLOB≡RAI;
PUT RAI IN PNTS AFTER ∞;
END "GEN3";
! MAKE ENDPT⊗RI≡PNTS[K];
END "GEN2";
END "GEN1";
OUTS ← TRUE;
IF XDMP THEN
BEGIN
OUT(3,"VERTICIES"&CRLF);
FOR I←1 STEP 1 UNTIL VIND DO
OUT(3,CVS(I)&CVF(VERT[I,1])&
CVF(VERT[I,2])&CRLF);
OUT(3,CRLF);
END;
IND ← 0;
⊃ generate regions;
WHILE TRUE DO
BEGIN "GENER"
Y ← 0;
FOR I←1 STEP 1 UNTIL C DO IF COUNT[I]<2 THEN
FOR K←2,4 DO IF LINES[I,K]>Y THEN
BEGIN
A←I;
B←K;
Y←LINES[I,K];
END;
IF ¬Y THEN DONE;
X1 ← XX ← X ← LINES[A,B-1];
⊃ FIND REGION BY STARTING WITH LOWEST ENDPOINT
AND FINDING SUCCESSIVE EDGES WITH SMALLEST
(LARGEST AFTER OUTSIDE) ANGLES BETWEEN THEM;
YY ← Y+100.0;
Y1 ← Y;
B ← 0;
FOOX ← ! NEW;
VERTICIES ← PHI;
FOO ← ! NEW(PHI);
! MAKE REGION⊗NEWBLOB≡FOOX;
! MAKE PERIMETER⊗FOOX≡FOO;
IF OUTS THEN ! MAKE BACKGROUND⊗NEWBLOB≡FOOX;
PUT PNTS[GET(X,Y)] IN VERTICIES AFTER ∞;
DO BEGIN "REGION"
A1 ← IF OUTS∨¬B THEN 100.0 ELSE -100.0;
B1 ← ANG(XX-X,YY-Y);
REGINT(C,B,X,Y,I,J,COUNT[1],LINES[1,1]);
WHILE REGGET DO
BEGIN "GET"
F ← IF J=1 THEN 3 ELSE 1;
C1←ANG(LINES[I,F]-X,LINES[I,F+1]-Y);
C1←IF C1<B1 THEN 4+C1-B1 ELSE C1-B1;
K←IF OUTS∨¬B THEN C1<A1 ELSE C1>A1;
IF K THEN BEGIN A1←C1; A←I; E←F; END;
END "GET";
IF ABS(A1)=100.0 THEN
BEGIN
OUTSTR("REGION FINDER BLEW UP"&CRLF);
CALL(0,"EXIT");
END;
XX ← X;
YY ← Y;
X ← LINES[A,E];
Y ← LINES[A,E+1];
B ← A;
COUNT[A] ← COUNT[A]+1;
PUT PNTS[GET(X,Y)] IN VERTICIES AFTER ∞;
END "REGION" UNTIL
ABS(X-X1)<.001∧ABS(Y-Y1)<.001;
OUTS ← FALSE;
∂(FOO) ← VERTICIES;
END "GENER";
END "DATA";
END;
⊃ PROCESS FITTED OUTLINE;
PROCEDURE PROCESS(SAFEX REAL ARRAY LINES;SAFEX SHORT INTEGER ARRAY JOIN;
SHORT INTEGER SCNT,TST);
BEGIN SET S;
SAFEX REAL ARRAY ITEMVAR D;
DEFINE ∂="GLOBAL DATUM";
SHORT INTEGER I,L;
IF DISCUR THEN
BEGIN
OUTSTR("DEBUG MERGING?");
XDEB ← INCHWL="Y";
END;
FIXUP(LINES,JOIN,SCNT,TST);
IF (XDEB←¬RUN∨DIS_CUR) THEN
BEGIN
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL SCNT DO
BEGIN
FRDCHG(LINES[I,1],LINES[I,2],RIVECT);
FRDCHG(LINES[I,3],LINES[I,4],RVECT);
END;
S ← GLOBAL DANGLE⊗NEWBLOB;
IF LENGTH(S) THEN
BEGIN "DANGLE"
D ← LOP(S);
L ← ARRINFO(∂(D),2);
FOR I←1 STEP 1 UNTIL L DO
BEGIN
FRDCHG(∂(D)[I,1],∂(D)[I,2],RIVECT);
FRDCHG(∂(D)[I,3],∂(D)[I,4],RVECT);
END;
END "DANGLE";
DPYOUT(FRAMEX);
END;
END;
⊃ COMPUTE 'ANGLE' FOR CLOSED CURVE ROUTINE;
SIMPLE REAL PROCEDURE ANG(REAL DX, DY);
BEGIN REAL A;
A ← IF DY≥0 THEN DY↑2 ELSE -(DY↑2);
A ← A/(DX↑2+DY↑2);
IF DX<0 THEN A←2-A ELSE IF DY<0 THEN A←4+A;
RETURN(A);
END;
⊃ FIT COMMAND ENTRY
STATUS= -2 CURVE FITTER REJECTED OBJECT
0 OK - CLOSED OUTLINE
1 OK - LINE SEGMENT ;
MESSAGE PROCEDURE CURVE_FIT(REAL ARRAY D);
BEGIN SAFEX REAL ARRAY LINES[1:SMAX,1:4];
SAFEX SHORT INTEGER ARRAY JOIN[1:SMAX,1:2];
SHORT INTEGER SCNT, TST;
TST ← CURVE_STATUS;
TOLER ← CUR_T1;
TOLER2 ← CUR_T2;
MINLEN ← CUR_ML;
CORDIF ← CUR_CL;
CORMX ← CUR_MX;
COORDIF ← CUR_LD;
COORDMAX ← CUR_VD;
NEWBLOB ← CVI(D[1,3]);
PUT NEWBLOB IN BLOBS;
IF ¬(2048<D[1,3]<4096) THEN
BEGIN
OUTSTR("IGL ITEM NUMBER"&CRLF);
RETURN;
END;
IF CURCAM[TVCAM]≠NIL∧¬YES_EDGE THEN
GLOBAL MAKE XFORM⊗NEWBLOB≡CURCAM[TVCAM];
XDEB ← FALSE;
IF (CURVE_STATUS←CUR1(D,LINES,JOIN,SCNT,SMAX))<0 THEN RETURN;
STAT_CURV ← FALSE;
CURVE_STATUS ← 0;
PROCESS(LINES,JOIN,SCNT,TST);
IF XDEB THEN DISP(D);
IF ¬STAT_CURV THEN CURVE_STATUS ← 1;
END;
⊃ DUMP CURVE FITTER DATA STRUCTURE ON DISK FILES;
MESSAGE PROCEDURE GLBDMP(SET ARG);
BEGIN SET S;
LIST PNTS, LINES, REG, PER;
SAFEX REAL ARRAY ITEMVAR DANG;
ITEMVAR BLB;
SHORT INTEGER CHAN, I, J, K, L, SI, SJ;
DEFINE ∂="GLOBAL DATUM", !="GLOBAL", CRLF="'15&'12", TAB=""" """;
OUTSTR("FILE NAME IS"&CRLF);
OPEN(CHAN←GETCHAN,"DSK",0,0,6,1000,I,I←FALSE);
ENTER(CHAN,INCHWL,I);
IF I THEN
BEGIN
OUTSTR("ENTER FAILED"&CRLF);
RELEASE(CHAN);
RETURN;
END;
GETFORMAT(SI,SJ);
SETFORMAT(0,8);
OUT(CHAN,CVS(LENGTH(ARG))&" NUMBER OF OBJECTS"&CRLF);
WHILE LENGTH(ARG) DO
BEGIN "OBJECT"
BLB ← LOP(ARG);
PNTS ← CVLIST(! POINT⊗BLB);
L ← LENGTH(PNTS);
OUT(CHAN,CVS(L)&" # OF VERTICIES-START OBJECT"&CRLF);
FOR I←1 STEP 1 UNTIL L DO
OUT(CHAN,CVF(∂(PNTS[I],REAL ARRAY)[1])&TAB&
CVF(∂(PNTS[I],REAL ARRAY)[2])&
" VERTEX "&CVS(I)&" (X Y)"&CRLF);
LINES ← CVLIST(! LINE⊗BLB);
L ← LENGTH(LINES);
OUT(CHAN,CVS(L)&" # OF LINES"&CRLF);
FOR I←1 STEP 1 UNTIL L DO
BEGIN "LINE"
REAL ITEMVAR LN;
LN ← LINES[I];
S ← ! ENDPT⊗LN;
OUT(CHAN,CVF(∂(LN,REAL))&TAB&
CVS(LISTX(PNTS,LOP(S),1))&TAB&
CVS(LISTX(PNTS,LOP(S),1))&" LINE "&CVS(I)&
" LENGTH - ENDPT VERTEX #S"&CRLF);
END "LINE";
REG ← CVLIST(! REGION⊗BLB);
L ← LENGTH(REG);
OUT(CHAN,CVS(L)&" # OF REGIONS"&CRLF);
IF L THEN
BEGIN "REGION"
S ← ! BACKGROUND⊗BLB;
IF (J←LISTX(REG,LOP(S),1))≠1 THEN
PUT REG[J] IN REG BEFORE 1;
FOR I←1 STEP 1 UNTIL L DO
BEGIN "PERIM"
S ← ! PERIMETER⊗REG[I];
PER ← ∂(LOP(S),LIST);
J ← LENGTH(PER);
OUT(CHAN,CVS(J)&" ");
FOR K←1 STEP 1 UNTIL J DO
OUT(CHAN,CVS(LISTX(PNTS,PER[K],1))&
" ");
OUT(CHAN," R"&CVS(I)&" CNT & VERTEX #S"&
CRLF);
END "PERIM";
END "REGION";
S ← ! DANGLE⊗BLB;
L ← LENGTH(S);
IF L THEN
BEGIN
DANG ← LOP(S);
L ← ARRINFO(∂(DANG),2);
END;
OUT(CHAN,CVS(L)&" # OF DANGLING LINES"&CRLF);
FOR I←1 STEP 1 UNTIL L DO
BEGIN "DANG"
FOR J←1 STEP 1 UNTIL 4 DO
OUT(CHAN,CVG(∂(DANG)[I,J])&TAB);
OUT(CHAN,"X1,Y1 X2,Y2 OF EXTRA LINE "&CVS(I)&CRLF);
END "DANG";
S ← ! XFORM⊗BLB;
L ← LENGTH(S);
IF L THEN
BEGIN
DANG ← LOP(S);
L ← ARRINFO(∂(DANG),2);
END;
OUT(CHAN,CVS(L)&" LENGTH OF CAMERA TRANSFORM"&CRLF);
FOR I ← 1 STEP 1 UNTIL L DO
BEGIN "TRANS"
FOR J←1 STEP 1 UNTIL 3 DO
OUT(CHAN,CVF(∂(DANG)[I,J])&TAB);
OUT(CHAN,CRLF);
END "TRANS";
END "OBJECT";
RELEASE(CHAN);
SETFORMAT(SI,SJ);
END;
⊃ MAIN PROGRAM;
LABEL L1;
IF ¬CUR_INIT THEN
BEGIN
CUR_T1 ← 0.2;
CUR_T2 ← 0.7;
CUR_ML ← 0.0;
CUR_CL ← 150.0;
CUR_MX ← 1000.0;
CUR_LD ← 15.0;
CUR_VD ← 4.0;
CUR_INIT ← TRUE;
END;
TVCAM ← 1;
IF ¬(YES_EDGE∨YES_CAM) THEN
BEGIN
CURCAM[1] ← NIL;
CURCAM[2] ← NIL;
END;
SETBREAK(1,'12,'15,"IN");
PTYDPY ← DISDEV;
PUT_DATA(0,0,"CURVE");
DPYCLR;
FRAMEY ← FRAMEX ← I ← -1;
OVERLAY ← YES_CUR ← TRUE;
CODE('51300000000,I);
DD_DISP ← ¬(I LAND '400000000000);
PARA ← 0.4;
L1: IF RUN∧¬DEB_CUR THEN WHILE TRUE DO
BEGIN
I ← GET_ENTRY('130,"EDGE","CURVE",NULL);
QUEUE('600,I);
IF DEB_CUR THEN DONE;
END;
WHILE TRUE DO
BEGIN
SHORT INTEGER TST;
IF RUN∧¬DEB_CUR THEN GO TO L1;
BLOBS ← PHI;
OUTSTR("DEBUG? ");
IF INCHWL="Y" THEN CURVON ELSE CUROFF;
IF ¬RUN THEN DPYTYP(-170,2,6);
OUTSTR("MERGE LINES ?");
TST ← INCHWL≠"Y";
SETFORMAT(0,0);
OPEN(1,"DSK",0,2,2,1000,BRK,EOF);
OUTSTR("FILE ="&CRLF);
LOOKUP(1,INCHWL,J);
IF J THEN USERERR(0,0,"LOOKUP FAILED");
⊃ READ IN OBJECTS FROM DISK FILE AND PROCESS;
I ← INTSCAN(INP←INPUT(1,1),BRK);
BEGIN SAFEX REAL ARRAY DAT[1:I,1:4];
SHORT INTEGER ST, K, SE, SI, SK;
FOR J←1 STEP 1 UNTIL I DO
BEGIN
INP ← INPUT(1,1);
FOR K←1 STEP 1 UNTIL 4 DO
DAT[J,K]←REALSCAN(INP,BRK);
END;
DISSIZ ← I+20;
I ← INTSCAN(INP←INPUT(1,1),BRK);
IF I>0 THEN
BEGIN SAFEX REAL ARRAY T[1:I,1:3];
SHORT INTEGER K;
FOR J←1 STEP 1 UNTIL I DO
BEGIN
INP ← INPUT(1,1);
FOR K←1 STEP 1 UNTIL 3 DO
T[J,K]←REALSCAN(INP,BRK);
END;
IF I≥10 THEN TVCAM←T[10,1];
IF CURCAM[TVCAM]≠NIL THEN
GLOBAL DELETE(CURCAM[TVCAM]);
CURCAM[TVCAM] ← GLOBAL NEW(T);
END;
ST ← 1;
DO BEGIN "OBJ" SHORT INTEGER L;
SI ← ST;
CURVE_STATUS ← TST;
SE ← ST+DAT[ST,1]+1;
WHILE DAT[SI,2]∧¬DAT[SE,3] DO
BEGIN
SI ← SE;
SE ← SE+DAT[SE,1]+1;
END;
L ← SE-ST;
BEGIN SAFEX REAL ARRAY D[1:L,1:4];
ARRBLT(D[1,1],DAT[ST,1],L*4);
D[SI-ST+1,2] ← 0;
SK ← 1;
WHILE D[SK,2] DO SK←D[SK,2]←
D[SK,2]-ST+1;
WHILE TRUE DO
BEGIN
FRAMEX ← GETPOG;
IF FRAMEX<0 THEN
DPYCLR ELSE DONE;
END;
DISP(D);
CURVE_FIT(D);
END;
ST ← SE;
END "OBJ" UNTIL ¬DAT[SI,2];
END;
OUTSTR("DUMP OUTPUT?"&CRLF);
IF INCHWL ="Y" THEN
BEGIN
OUTSTR("Current object or All"&CRLF);
GLBDMP(IF INCHWL="C" THEN {NEWBLOB} ELSE BLOBS);
END;
RELEASE(1);
RELEASE(3);
END;
END;